home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / code_lib / objlibr / objlib12 / objlib.mdb / Mouse.json < prev   
Encoding:
JavaScript Object Notation  |  1994-10-15  |  2.4 KB
  1. {
  2.     "schema": {
  3.         "Name": "Text (40)",
  4.         "Notes": "Text (255)",
  5.         "Module": "Memo/Hyperlink (255)",
  6.         "Form": "OLE (255)",
  7.         "FormCode": "Memo/Hyperlink (255)"
  8.     },
  9.     "data": [
  10.         {
  11.             "Name": "Cursor",
  12.             "Module": "\r\n\r\nSub SelectWindow (op%, F As Form, X, Y)\r\nDim h%, txt$, s$, n%, r%, oldmode%\r\nDim p As POINTAPI, w%, temp&\r\nStatic pointing%\r\n'\r\nSelect Case op%\r\nCase 1'initiate selection of a window\r\n    r% = setcapture(hWnd)\r\n    pointing% = True\r\n    r% = GetCursor(CInt(F.hWnd), 3)\r\nCase 0'end selection\r\n    pointing% = 0\r\n    p.X = X: p.Y = Y\r\n    ClientToScreen hWnd, p\r\n    'convert pointapi to long:\r\n    temp& = p.X + CLng(p.Y) * &H10000\r\n    'get window handle\r\n    h% = WindowFromPointByNum%(temp&): Debug.Print Hex(h)\r\n    'reset cursor\r\n    r% = GetCursor(CInt(Me.hWnd), 2)\r\n    ReleaseCapture\r\n    '\r\n    If h = 0 Then\r\n    Beep\r\n    Else\r\n    MsgBox \"Handle : \" & h\r\n    End If\r\n    '\r\nEnd Select\r\nEnd Sub\r\n\r\nFunction GetCursor (hWnd%, op%)\r\nStatic dllinst%, r%\r\nStatic hPaste%, hPick%, hNoDrop%, hOld%, doing%\r\nDim F$\r\n'\r\n'note: the handles are declared static and 'op%' is\r\n'used as a flag to allow all this code stay together\r\n\r\nSelect Case op%\r\nCase 0'unload dll\r\n    r% = DestroyCursor(hPaste%)\r\n    r% = DestroyCursor(hPick%)\r\n    FreeLibrary dllinst%\r\nCase 1'load dll\r\n    F$ = App.Path & \"\\test.dll\"\r\n    dllinst% = LoadLibrary(F$)\r\n    'Debug.Print dllinst%, Hex(dllinst%)\r\n    If dllinst% < 32 Then\r\n    'If MsgBox(\"Error loading cursors. Continue?\", 36, \"DLL LOAD ERROR\") <> 6 Then End\r\n    End If\r\n    hNoDrop% = LoadCursor(dllinst%, \"NODROP\")\r\n    hPaste% = LoadCursor(dllinst%, \"PASTE\")\r\n    hPick% = LoadCursor(dllinst%, \"PICK\")\r\nCase 2'restore default cursor\r\n    r% = SetCursor(hOld%)\r\n    doing% = 0\r\nCase 3'load PICK cursor\r\n    If doing% Then r% = SetCursor(hOld%)\r\n    hOld% = SetCursor(hPick%)\r\n    doing% = -1\r\nCase 4'load PASTE cursor\r\n    If doing% Then r% = SetCursor(hOld%)\r\n    hOld% = SetCursor(hPaste%)\r\n    doing% = -1\r\nEnd Select\r\n\r\n\r\nEnd Function\r\n\r\n",
  13.             "FormCode": "\r\n\r\nSub Form_Load ()\r\nDim r%\r\nr = GetCursor(CInt(hWnd), 1)\r\n\r\nEnd Sub\r\n\r\nSub Form_MouseDown ()\r\nSelectWindow 1, Me, 0, 0\r\n\r\nEnd Sub\r\n\r\nSub Form_MouseUp ()\r\nSelectWindow 0, Me, X, Y\r\n\r\nEnd Sub\r\n\r\nSub Form_Unload ()\r\nDim r%\r\nr = GetCursor(CInt(hWnd), 0)\r\n\r\nEnd Sub\r\n\r\n"
  14.         }
  15.     ]
  16. }